home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacTech 1 to 12
/
MacTech-vol-1-12.toast
/
Tools
/
Alpha 6.51b13 ƒ
/
Tcl
/
Modes
/
schemeMode.tcl
< prev
next >
Wrap
Text File
|
1996-08-15
|
6KB
|
152 lines
if {$startingUp} {
#================================================================================
addMode Scm dummyScm {*.scm} {}
return
}
#================================================================================
# Scheme mode definition ! oleg@ponder.csci.unt.edu (Oleg Kiselyov)
#
# $Id: SchemeMode.tcl,v 1.3 1996/07/03 14:19:49 oleg Exp oleg $
#================================================================================
#newModeVar Scm elecRBrace {1} 1
newModeVar Scm leftFillColumn {2} 0
newModeVar Scm prefixString {;; } 0
#newModeVar Scm electricSemi {1} 1
newModeVar Scm wordBreak {[^\(\) \t\r\n]+} 0
#newModeVar Scm elecLBrace {1} 1
newModeVar Scm wordWrap {0} 1
newModeVar Scm funcExpr {^[\(]define.*$} 0
#newModeVar Scm funcExpr {^[^ \t\(\r/].*\(.*\)$} 0
newModeVar Scm wordBreakPreface {[\(\) \t\r\n]} 0
#newModeVar Scm wordBreakPreface {([^a-zA-Z0-9_])} 0
newModeVar Scm optionIsMeta {1} 1
newModeVar Scm electricTab {1} 1
newModeVar Scm autoMark 0 1
set scmCommentRegexp {;.*$}
set scmPreRegexp {^\#[\t ]*[a-z]*}
set schemeKeyWords {
declare define define-macro lambda let let* letrec begin cond case do else
delay and or if set! #t #f
not eqv? eq? equal? pair? cons car cdr set-car! set-cdr!
caar cadr cdar cddr null? list? list length
append reverse list-ref memq memv member assq assv assoc
= < > <= >= zero? positive? negative? odd?
even? + * - / abs
exact->inexact inexact->exact number->string
string->number char?
string string-length string-ref string-set! string=?
substring string-append vector?
make-vector vector vector-length vector-ref vector-set! procedure?
apply map for-each call-with-current-continuation
eof-object? read-char peek-char
}
#regModeKeywords -e {;} -c cyan -k blue Scm $schemeKeyWords -i ")" -i "(" -i "," -i "." -I red
regModeKeywords -e {;} -c cyan -k blue -s green Scm $schemeKeyWords
# meaning that a Tab key does indentation, while Option+Tab or Ctrl+Tab
# do the regular mundane \t
# See indentLine.tcl for more details
bind '\t' doATab Scm
bind '\t' <o> {doATab 1} Scm
bind '\t' <z> {doATab 1} Scm
#================================================================================
proc dummyScm {} {}
proc ScmMarkFile {} {
set pat1 {^[ \t]*[\(][#a-zA-z]*(define|define-[a-zA-Z]+) +[\(]*([^\(\) \t\r\n]+)}
set end [maxPos]
set pos 0
set l {}
while {![catch {search -f 1 -r 1 -m 0 -i 1 $pat1 $pos} mtch]} {
regexp -nocase $pat1 [eval getText $mtch] allofit defunname name
set start [lindex $mtch 0]
set end [nextLineStart $start]
set pos $end
set inds($name) [lineStart [expr $start - 1]]
}
if {[info exists inds]} {
foreach f [lsort -ignore [array names inds]] {
set next [nextLineStart $inds($f)]
setNamedMark $f $inds($f) $next $next
}
}
}
#================================================================================
# Indenting a line of a Scheme code
#
# The idea is simple: the indent of a new line is the same as the indent of the
# previous non-empty non-comment-only line *plus* the paren balance of that
# line times two
# That is, if the last code line was paren balanced, the next line would have
# the same indent. If the prev line opened an expression but didn't close it,
# the new line would be indented further
#
# See indentLine.tcl for more details
proc ScmindentLine {} {
set beg [lineStart [getPos]]
set end [nextLineStart [getPos]]
# Find last previous non-comment line and get its leading whitespace
set pos $beg
set lst [search -s -f 0 -r 1 -i 0 {^[ \t]*[^ ;\t\r\n]} [expr $pos-1]]
set line [getText [lindex $lst 0] [expr [nextLineStart [lindex $lst 0]] - 1]]
set lwhite [getText [lindex $lst 0] [expr [lindex $lst 1] - 1]]
# computing the balance of parentheses within the 'line'
# This appears to be utterly elementary. One has to keep in mind however
# that parentheses might appear in comments and/or quoted strings,
# in which case they shouldn't count. Although it's easy to detect a
# Scheme comment by a semicolon, a semicolon can also appear within
# a quoted string. Note that a double quote isn't that sure a sign of
# a quoted string: the double quote may be escaped. And the backslash
# can be escaped in turn... Thus we face a full-blown problem of parsing
# a string according to a context-free grammar.
# We note however that a TCL interpretor does similar kind of parsing
# all the time. So, we can piggy-back on it and have it decide what is
# the quoted string and when a semicolon really starts a comment. To this
# end, we replace all non-essential characters from the 'line' with spaces,
# separate all parens with spaces (so each paren would register as a
# separate token with the TCL interpretor), replace a semicolon with
# an opening brace (which, if unescaped and unquoted, acts as some kind
# of "comment", that is, shields all symbols that follows).
# After that, we get TCL interpretor to convert thus prepared 'line'
# into a list, and simply count the balance of '(' and ')' tokens.
regsub -all -nocase {[^ ();\"\\]} $line { } line1
regsub -all {;} $line1 "\{" line
regsub -all {[()]} $line { \0 } line1
set line_list [eval "list $line1 \}"]
#alertnote ">$line_list<"
set balance 0
foreach i $line_list { switch $i ( {incr balance} ) {incr balance -1} }
#alertnote "balance $balance, lwhite [string length $lwhite]"
if {$balance < 0} {
set lwhite [string range $lwhite 0 [expr [string length $lwhite] + 2 * $balance - 1]]
} else {
append lwhite [string range " " 1 [expr 2 * $balance]]
}
#alertnote "new lwhite [string length $lwhite]"
set text [getText $beg [nextLineStart $beg]]
regexp {^[ \t]*} $text white
set len [string length $white]
if {$white != $lwhite} {
replaceText $beg [expr $beg + $len] $lwhite
}
goto [expr $beg + [string length $lwhite]]
return
}